Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/pgm_util/callli/calllist.frm

Visual Basic Form | 1994-10-17 | 44.6 KB | 1,187 lines

VERSION 2.00
Begin Form Form1
   Caption         =   "Form1"
   ClientHeight    =   6525
   ClientLeft      =   165
   ClientTop       =   690
   ClientWidth     =   9435
   Height          =   7365
   Left            =   30
   LinkTopic       =   "Form1"
   ScaleHeight     =   435
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   629
   Top             =   -15
   Width           =   9705
   WindowState     =   2  'Maximized
   Begin ListBox listmodulenames
      DragIcon        =   CALLLIST.FRX:0000
      Height          =   3930
      Left            =   6540
      Sorted          =   -1  'True
      TabIndex        =   11
      Top             =   300
      Width           =   2415
   End
   Begin PictureBox picarrowdn
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      Height          =   255
      Left            =   5880
      Picture         =   CALLLIST.FRX:0302
      ScaleHeight     =   15
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   20
      TabIndex        =   10
      Top             =   6240
      Visible         =   0   'False
      Width           =   330
   End
   Begin PictureBox picarrowup
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      Height          =   255
      Left            =   6000
      Picture         =   CALLLIST.FRX:0868
      ScaleHeight     =   225
      ScaleWidth      =   300
      TabIndex        =   9
      Top             =   5820
      Visible         =   0   'False
      Width           =   330
   End
   Begin CheckBox Check1
      Caption         =   "Locked"
      Height          =   495
      Index           =   0
      Left            =   4800
      TabIndex        =   8
      Top             =   300
      Width           =   975
   End
   Begin CommonDialog CMDialog1
      Filter          =   "Forms (*.FRM)|*.frm|Modules (*.BAS)|*.bas"
      InitDir         =   "c:\vb\erase"
      Left            =   6360
      Top             =   6120
   End
   Begin PictureBox Picture1
      Height          =   5775
      Left            =   480
      ScaleHeight     =   5745
      ScaleWidth      =   6465
      TabIndex        =   4
      Top             =   120
      Visible         =   0   'False
      Width           =   6495
      Begin CommandButton btnclose
         Caption         =   "Close"
         Height          =   555
         Left            =   4980
         TabIndex        =   15
         Top             =   4680
         Width           =   1335
      End
      Begin TextBox Text1
         Height          =   4335
         Left            =   120
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   14
         Text            =   "Text1"
         Top             =   1260
         Width           =   4455
      End
      Begin CommandButton Command3
         Caption         =   "Close"
         Height          =   495
         Left            =   8400
         TabIndex        =   7
         Top             =   5760
         Width           =   855
      End
      Begin Label Label8
         Caption         =   "If you have comments, or if you found a bug, or if you have an idea for a feature to add, please contact me on CompuServe, 71630,1265."
         Height          =   615
         Left            =   60
         TabIndex        =   6
         Top             =   420
         Width           =   4635
      End
      Begin Label Label7
         Caption         =   "Programmed by Steve Denenberg"
         Height          =   315
         Left            =   120
         TabIndex        =   5
         Top             =   0
         Width           =   3075
      End
   End
   Begin ListBox list1
      Height          =   1005
      Index           =   0
      Left            =   60
      TabIndex        =   0
      Top             =   120
      Width           =   4335
   End
   Begin Label Label5
      Height          =   315
      Left            =   7740
      TabIndex        =   3
      Top             =   4560
      Width           =   1635
   End
   Begin Label Label4
      Caption         =   "Inputting:"
      Height          =   255
      Left            =   6720
      TabIndex        =   13
      Top             =   4560
      Width           =   855
   End
   Begin Label Label3
      Caption         =   "Module Names"
      Height          =   315
      Left            =   6780
      TabIndex        =   12
      Top             =   0
      Width           =   1395
   End
   Begin Label Label2
      Caption         =   "Lines read:"
      Height          =   255
      Left            =   6660
      TabIndex        =   2
      Top             =   4980
      Width           =   975
   End
   Begin Label Label1
      Caption         =   "0"
      Height          =   315
      Left            =   7740
      TabIndex        =   1
      Top             =   4980
      Width           =   855
   End
   Begin Menu zzfileitem
      Caption         =   "&File"
      Begin Menu openfileitem
         Caption         =   "&Open"
      End
      Begin Menu zzsep
         Caption         =   "-"
      End
      Begin Menu exititem
         Caption         =   "E&xit"
      End
   End
   Begin Menu zzmoveboxesitem
      Caption         =   "&Move boxes"
      Begin Menu moveboxesupitem
         Caption         =   "&Up"
      End
      Begin Menu moveboxesdownitem
         Caption         =   "&Down"
      End
   End
   Begin Menu zzhelpitem
      Caption         =   "&Help"
      Begin Menu howtousesubfinderitem
         Caption         =   "How to Use Sub Finder"
      End
   End
Option Explicit
Dim dontrecurse As Integer
Dim maxlength1 As Integer
Const maxlistboxindex = 4
Dim maxlength2  As Integer
Dim totalnumberofsubs As Integer
Dim dontrecurse2 As Integer
Option Compare Text
Dim modulereference(700, 25) As Integer
Dim modulename(100) As String
Dim lineoftext(200) As String
Dim fileend As Integer
Dim thiscallsallofthese(4) As Integer
Dim filetoopen As String
Dim bodyindex As Integer
Const locked = 1
'first parameter is the sub or function number
'second parameter lists the subs that are called within the sub
'  indexed in the first parameter
'each listbox has an associated flag, thiscallsallofthese(), which
'  tells whether the label between that list box and the list box
'  BELOW it is thiscalls all of these, or all of these call this
Dim sublist(10, 10, 10) As String
'when a module is loaded into a list box:
'  load into that list box the subs in that module
'  do nothing else at that time
'when a listbox entry is selected:
'  if the listbox below (deep) to that listbox is not locked, then
'  if there is a selected entry in the deep listbox, save it in a variable
'  enter into the listbox below all of the subs that the selected
'  sub calls.  set thiscallsallof these() to true for the listbox
'  where the sub was selected.
'  if the deep listbox had thiscallsallof these(), then look for a match
'  between the saved variable and the new entries in the deep listbox.
'  If there is a match, select that item.
'  If there is not a match, selecte no item, and clear all the listboxes
'  deep to the deep listbox
'  if the deep listbox has NOT thiscallsallofthese(), select no item in
'  the deep listbox, and clear all the listboxes deep to the deep listbox
'  if the listbox above that listbox is not locked, then
'  if there is a selected item in the superficial listbox, save it in
'  a variable.
'  load into that
'  listbox all the subs that call the sub that was selected.  set
'  thiscallsallofthese() to false for the superficial listbox.
'  look for a match between the saved item and the new contents of the
'  superficial listbox.  If there is a match and superficial^2 has
'  allofthesecallthis(), then highlight the saved item.  Otherwise, clear
'  superficial^2 and all listboxes superficial to superficial^2.
'when an item in a listbox is selected, if the box deep to that is locked,
'  then
'  if thiscallsallofthese for the selected listbox, give a message that
'  the box below has to be unlocked before a selection can be made in
'  the listbox that was selected.
'  if allofthesecallthis for the selected listbox, then
'  if there is something highlighted in the superficial listbox, save
'  it in a variable.
'  if the box above is unlocked, then load into it all the subs that call
'  the selected sub, and set allofthesecallthis for the superficial listbox.
'  if superficial^2 is thiscallsallofthese, then clear it and all list
'  boxes above it.
'  if superficial^2 is allofthesecallthis, then look for the saved item in
'  superficial^1.  If it is there, highlight it.  If not, clear
'  superficial^2 and everything above it.
'  if the deep box is locked and the superficial box is locked, too, give
'  a message that one of them has to be unlocked first.
'when an item is selected in a listbox, if the superficial listbox is
'  locked, then
'  if superficial is thiscallsallofthese, deal with the deep boxes.
'  if superficial is allofthesecallthis, then give a message that
'  selection of this item will redo the superficial box.  Ok to proceed?
'  if ok to proceed, then unlock the box and proceed as if the box were
'  unlocked.
Dim doublequote As String * 1
Dim variableindex As Integer
Dim subnumber As Integer
Dim linesread As Integer
Dim z%
Dim cancelread As Integer
Sub btnclose_Click ()
picture1.Visible = False
End Sub
Sub Check1_Click (index As Integer)
If dontrecurse2 Then Exit Sub
'jjj need a new dontrecurse to move checkboxes.
If list1(index).ListCount = 0 Then
    dontrecurse = True
    check1(index).Value = 0
    dontrecurse = False
End If
End Sub
Sub Command3_Click ()
picture1.Visible = False
End Sub
Sub exititem_Click ()
End Sub
Sub findallsubreferences ()
Dim nextline As String
Dim inasub As Integer
Dim inafunction As Integer
Dim endoffile As Integer
Dim linesread As Long
Dim sublistindex As Integer
Dim maxlength1 As Integer
Dim nextmodule As String
Dim subindex2
Dim holdstring As String
Dim cc As Integer
Dim dd As Integer
Dim instring As Integer
Dim moduleindex As Integer
Dim subnameonly As String
Dim notdonewithsubyet As Integer
Dim wholesubstring As String
Dim xstring As String
moduleindex = 0
'On Error GoTo goterror3
subnumber = 0
Open filetoopen For Input As #2
Do   'over the different modules
If EOF(2) Then
    'exit if we are done with .MAK
    Close
    GoTo resetandpaint
End If
'get the next module name
Line Input #2, nextmodule
nextmodule = Trim$(nextmodule)
If Right$(nextmodule, 3) <> "frm" And Right$(nextmodule, 3) <> "bas" Then
    GoTo skipmakentry3
End If
moduleindex = moduleindex + 1
'start inputting the nextmodule
Open nextmodule For Input As #1
label5.Caption = nextmodule
label5.Refresh
'linesread starts out zero for each module
linesread = 0
'preparing to get another sub or function
more3:
'starting out, subnumber is one
inasub = False
inafunction = False
Do    'inputting the module text
'if done with this module, then get the next module
If EOF(1) Then
    Close #1
    GoTo gotthefile3
End If
'look for the sub or function name first
'if found, advance subnumber, and input the next line
'lots of lines will be put into one string so that the very large string
'  can be searched all at once, rather than cycling through all of the
'  sub names found for EVERY single line.
Line Input #1, nextline
If Len(nextline) > maxlength1 Then maxlength1 = Len(nextline)
linesread = linesread + 1
If linesread Mod 100 = 0 Then
    label1.Caption = Str$(linesread)
    label1.Refresh
End If
nextline = Trim$(nextline)
If Left$(nextline, 4) = "sub " Then
        inasub = True
        nextline = Right$(nextline, Len(nextline) - 4)
        GoTo initializenewroutine
    ElseIf Left(nextline, 9) = "function " Then
        inafunction = True
        nextline = Right$(nextline, Len(nextline) - 9)
        GoTo initializenewroutine
End If
'get to here, we have inputted a line that is not the first line
'  of a sub or function.
If (inasub And Left$(nextline, 7) = "end sub") Or (inafunction And Left$(nextline, 12) = "end function") Then
    'we are at the end of the routine, search the big string that
    '  we have been preparing
    GoTo searchwholesub
End If
If (Not inasub) And (Not inafunction) Then
    'just input the next line from the sub
    GoTo skipthisline
End If
'get to here, the line that we inputted from the module is not
'  the first of a sub, it's not the last, it is in a sub, go to the
'  place that will process it.
GoTo getlinedata
initializenewroutine:
'make sure the subs input in the same order
Dim thespace As Integer
thespace = InStr(nextline, " ")
If thespace = 0 Then
    MsgBox "sub or function found, but no name can be obtained", 48, "Error"
End If
subnumber = subnumber + 1
sublist2(0, 1) = Trim$(Left$(nextline, thespace - 1)) + "   " + nextmodule
If sublist2(subnumber, 0) <> sublist2(0, 1) Then
    MsgBox "the sub/function names don't count the same as first time through.", 48, "Error"
End If
'we are starting out a new sub or function.  Subnumber has been
'  updated.  Start over subindex2 and wholesubstring
subindex2 = 0
wholesubstring = ""
'this goto takes us to inputting the sub or function body after the
'  opening title line of the sub or function.
GoTo getnextline
getlinedata:
'get sub/function references from nextline
If Left$(nextline, 1) = "'" Then GoTo skipthisline
nextline = stripquotes(nextline)
wholesubstring = wholesubstring + " " + nextline
If Len(wholesubstring) > 30000 Then
        notdonewithsubyet = True
        GoTo searchwholesub
    Else
        'go get the next line
        GoTo skipthisline
End If
searchwholesub:
For cc = 1 To totalnumberofsubs
'don't test for this very sub name if in a function
If cc = subnumber And inafunction Then GoTo nextcc2
'strip out the name of the sub only
subnameonly = Left$(sublist2(cc, 0), InStr(sublist2(cc, 0), " "))
'see if the sub name is in the wholesubstring string
xstring = subnameonly
xstring = Trim$(xstring)
instring = InStr(wholesubstring, xstring)
If instring <> 0 Then
    'make sure the reference is not part of another word
    'make sure the following character isn't part of the same word
    Select Case Mid$(wholesubstring, instring + Len(xstring), 1)
        Case "a" To "z", "A" To "Z", "1" To "9", "0", "_"
            GoTo nextcc2
    End Select
    'make sure the preceeding character isn't part of the same word
    If instring > 1 Then
        Select Case Mid$(wholesubstring, instring - 1, 1)
            Case "a" To "z", "A" To "Z", "1" To "9", "0", "_"
                GoTo nextcc2
        End Select
    End If
    'if the module name of the sublist2(cc,0) that was found ends in
    '  .frm, then make sure that the module that we are currently
    '  searching is the same .frm
    If Right$(modulename(modulereference(cc, 0)), 3) = "frm" Then
        If modulename(modulereference(cc, 0)) <> nextmodule Then
            GoTo nextcc2
        End If
    End If
    'add this function name to sublist(subnumber,jj)
        For dd = 1 To subindex2 + 1
        If sublist2(subnumber, dd) = sublist2(cc, 0) Then GoTo nextcc2
        Next dd
        subindex2 = subindex2 + 1
        sublist2(subnumber, subindex2) = sublist2(cc, 0)
        modulereference(subnumber, subindex2) = moduleindex
        End If
nextcc2:
Next cc
If notdonewithsubyet = True Then
    notdonewithsubyet = False
    wholesubstring = ""
    GoTo skipthisline
End If
'go get the next sub
GoTo more3
skipthisline:
getnextline:
Loop      'getting the module text
gotthefile3:
skipmakentry3:
Loop     'inputting the different modules
resetandpaint:
'clear all check boxes and list boxes
For cc = 0 To maxlistboxindex
check1(cc).Value = 0
list1(cc).Clear
Next cc
'load listmodulenames
listmodulenames.Clear
cc = 0
cc = cc + 1
If modulename(cc) = "" Then
    Exit Sub
End If
listmodulenames.AddItem modulename(cc)
'goterror3:
'MsgBox Error$(Err)
'Exit Sub
End Sub
Sub Form_Load ()
Caption = "Sub Finder"
Dim cc As Integer
For cc = 1 To 4
Load list1(cc)
Load check1(cc)
Next cc
'waiting for sub or function start
'pull in a line
'if starts with sub or function, that's our first line
'  store it
'continue pulling in lines until we get to one that
'  says end sub or end function
'now go through the whole array we pulled in, and look for
'  dim xx
'  redim xx
'  static xx
' look for "(" or a space, which gives the end of the
'  variable name
'  can also look for commas, and for
'  commas within parentheses
'that will give us a list of variables to look for
'now cycle through the array, looking for variables
'might want to erase the dim statements after grabbing the
'  variables from them
'pull in a line.  Ignore the line if it starts with an
'  apostrophe.
'ignore everything between double quotation marks, including
'  apostrophe's
'ignore everything after an apostrophe
'make sure the variable, to be ok, starts the line, or is
'  prefaced by a ( or a space, and make sure it is followed
'  by a , or a ) or a space
'as variables are found, do something to clear them
doublequote = """"
End Sub
Sub form_paint ()
Dim cc As Integer
Dim z%
Dim uparrow As Integer
Dim downarrow As Integer
uparrow = 5
downarrow = list1(0).Left + list1(0).Width - picarrowup.Width
Dim uptext As Integer
uptext = uparrow + picarrowup.Width
For cc = 0 To 3
If list1(cc).ListCount = 0 Then GoTo nextcc02
If list1(cc + 1).ListCount = 0 Then GoTo nextcc02
z% = bitblt(hDC, uparrow, list1(cc).Top + list1(cc).Height + 1, picarrowup.Width, picarrowup.Height, picarrowup.hDC, 0, 0, srccopy)
z% = bitblt(hDC, downarrow, list1(cc + 1).Top - picarrowdn.Height, picarrowdn.Width, picarrowdn.Height, picarrowdn.hDC, 0, 0, srccopy)
If thiscallsallofthese(cc) Then
        currentx = uparrow + picarrowup.Width
        currenty = list1(cc).Top + list1(cc).Height + 4
        Print "THIS highlighted routine";
        'currenty = list1(cc + 1).Top - picarrowdn.Height - 4
        currentx = downarrow - TextWidth("calls ALL of these")
        Print "calls ALL of these"
    Else
        currentx = uparrow + picarrowup.Width
        currenty = list1(cc).Top + list1(cc).Height + 4
        Print "EACH of these";
       ' currenty = list1(cc + 1).Top - picarrowdn.Height - 4
        currentx = downarrow - TextWidth("calls THIS highlighted routine")
        Print "calls THIS highlighted routine"
End If
nextcc02:
Next cc
'jjj put this in list1().click
'If listmodulenames.ListCount = 0 Then
End Sub
Sub Form_Resize ()
Dim cc As Integer
Dim tween As Integer
Dim addtotween As Integer
For cc = 0 To maxlistboxindex
list1(cc).Left = 5
list1(cc).Width = 350
check1(cc).Left = list1(cc).Left + list1(cc).Width + 5
Next cc
tween = TextHeight("Tj") + 1.5
list1(0).Height = (scaleheight - tween * (maxlistboxindex)) / (maxlistboxindex + 1)
list1(0).Top = 0
addtotween = (scaleheight - tween * (maxlistboxindex)) / (maxlistboxindex + 1) - list1(0).Height
For cc = 1 To maxlistboxindex
list1(cc).Height = list1(0).Height
'(scaleheight - tween * (maxlistboxindex)) / (maxlistboxindex + 1)
list1(cc).Top = cc * (list1(0).Height + tween + addtotween)
Next cc
For cc = 0 To maxlistboxindex
check1(cc).Top = list1(cc).Top + list1(cc).Height / 2 - check1(cc).Height / 2
Next cc
For cc = 1 To maxlistboxindex
list1(cc).Visible = True
check1(cc).Visible = True
Next cc
End Sub
Sub howtousesubfinderitem_Click ()
Dim crlf As String
crlf = Chr$(13) + Chr$(10) + Chr$(13) + Chr$(10)
Dim x As String
x = x + "This program allows you to select a project file by using a "
x = x + "common dialog box.  All of the forms and modules of the project "
x = x + "will be analyzed for their subroutines and functions.  "
x = x + crlf + "You "
x = x + "will then be able to select any sub or function and see all of the other "
x = x + "subs and functions that are called by the selected sub or function.  "
x = x + "You will also be able to see all of the subs and functions "
x = x + "that CALL the selected sub or function." + crlf + "When you select "
x = x + "File... Open, "
x = x + "and select a project file, the program will analyze the forms and modules.  "
x = x + "As the analysis proceeds, you will be able to see the number of lines that are being read and "
x = x + "the form or module that is currently being analyzed.  The program will "
x = x + "go through all of the forms and modules twice -- once to find the names "
x = x + "of all the subs and functions, and "
x = x + "again to look for the names of the subs and functions in all the "
x = x + "lines of the program." + crlf + "When it is done, the names of the forms and "
x = x + "modules will be loaded into the list box on the right, entitled ''Module"
x = x + "Names.''" + crlf
x = x + "In order to start your analysis, you select one form or module in "
x = x + "the ''Module Names'' listbox, by using your LEFT mouse button.  Then, by "
x = x + "using your RIGHT mouse button, drag the module or form name from the "
x = x + "''Module Names'' list box into one of the five list boxes on the left "
x = x + "side of the form.  That list box will then be loaded with all of the "
x = x + "subs and functions that are in the form or module that you selected.  "
x = x + "You may drag the form or module to any of the five list boxes." + crlf
x = x + "Now, here is what happens when you select a sub or function in "
x = x + "the listbox on the left that you loaded with the subs and functions "
x = x + "from your selected form or module.  When you do that, the program "
x = x + "loads, into the listbox BELOW it, all of the subs and functions that "
x = x + "the highlighted sub CALLS.  Also, into the listbox ABOVE the one "
x = x + "where you have selected a sub, the program loads all of the subs "
x = x + "or functions that CALL the one you selected.  You will be able to keep "
x = x + "that straight, because the listboxes will be captioned appropriately." + crlf
x = x + "If you click on a sub in a list box, and the list box below stays empty, that means that the sub or function that you highlighted calls no other subs or functions.  "
x = x + "If you click on a sub in a list box, and the list box above stays empty, that means that the sub or function that you highlighted is not called by any other sub or function." + crlf
x = x + "Each listed sub or function is followed by the name of the module or form that "
x = x + "contains it.  You may find that helpful, because you can trace which modules hold the subs that call and are called by the subs you are evaluating, and certainly there are many subs called ''Form_Paint,'' for example, and you will need to know which form's Form_Paint sub is being referenced." + crlf + "If you are about to click on a sub or function in a list "
x = x + "box, and you don't want the list box above or below to change with "
x = x + "your selection, then use the check boxes to the right of the list boxes "
x = x + "to lock the information in that particular list box.  Here's how locking a list box can be useful to you.  Let's say that "
x = x + "the list boxes are numbered 1 through 5, with 1 at the top.  Let's say "
x = x + "that you load a module of subs into listbox 2.  When you click on one "
x = x + "of the subs in listbox 2, listbox 3 now loads with all of the subs that "
x = x + "are called by the sub that you highlighted in listbox 2.  Now, let's say "
x = x + "that the sub you clicked on in listbox 2 calls a sub named mysub(), which "
x = x + "is now listed in listbox 3.  You want to see what different subs mysub() calls.  "
x = x + "However, if you click on mysub, listbox 4 will fill with the subs that "
x = x + "mysub calls, but LISTBOX 2 WILL FILL WITH ALL THE SUBS THAT CALL MYSUB.  "
x = x + "If you don't want to change what is shown in listbox 2, then lock that "
x = x + "listbox before clicking on listbox 3." + crlf
x = x + "If you want to follow a call list of subs deeper, but you are already "
x = x + "in listbox 5, use the menu item that moves the boxes up, and you'll have "
x = x + "more room to follow subs deeper.  You may also move the boxes down if "
x = x + "you bump into the top list box and you still want to find the subs that "
x = x + "call the subs listed in the top list box." + crlf
x = x + "Your program files have to be stored ''as text'' for this to work." + crlf + "The "
x = x + "program only reads files.  It doesn't write to any files on the disk, so "
x = x + "it shouldn't corrupt anything.  No guarantees." + crlf
x = x + "As with LOCALDIM.ZIP, I'm including the source code for those who are curious.  It is not polished code.  If you find a bug, let "
x = x + "me know, and I'll try to fix it.  If you want a feature added, let me "
x = x + "know, and we'll see." + crlf + "There is no error handling in the program.  Your "
x = x + "project should have fewer than 2000 total subs and functions, and "
x = x + "no sub or function should call more than 50 others -- although if you "
x = x + "have bigger needs, just change the dimension parameters of sublist2(), which resides in CALLIST3.BAS." + crlf
x = x + "If these directions are confusing, send me mail or a message, or just play with the program for a while and then "
x = x + "go through and read the instructions again.  They may make more sense the second time!" + crlf + "   --Steve Denenberg  71630,1265"
text1.Text = x
picture1.Left = 0
picture1.Top = 0
picture1.ZOrder
picture1.Visible = True
End Sub
Sub list1_Click (index As Integer)
Dim savedselecteditem As String * 50
Dim currentselection As String * 50
Dim cc As Integer
Dim sublistindex As Integer
Dim dd As Integer
Dim ee As Integer
Dim thesub As Integer
If dontrecurse Then Exit Sub
currentselection = list1(index).List(list1(index).ListIndex)
'when a listbox entry is selected:
'deal with the deeper boxes first
'if it is the deepest list box, don't do anything with the deep stuff
If index = maxlistboxindex Then
    GoTo dealwithsuperficialboxes
End If
'  if the listbox below (deep) to that listbox is not locked, then
If check1(index + 1).Value <> locked Then
    '  if there is a selected entry in the deep listbox,
    '    save it in a variable
    If list1(index + 1).ListIndex <> -1 Then
            savedselecteditem = list1(index + 1).List(list1(index + 1).ListIndex)
        Else
            savedselecteditem = ""
    End If
    '  enter into the deep listbox all of the subs that the selected
    '  sub calls.
    'first, find the sublist index for the selected sub or function
    sublistindex = 0
    Do
    sublistindex = sublistindex + 1
    If sublist2(sublistindex, 0) = currentselection Then
            Exit Do
        ElseIf sublist2(sublistindex, 0) = sublist2(0, 0) Then
            MsgBox "Went through the whole sublist2() array, and couldn't find the selected sub or function.", 48, "Error"
            Exit Sub
    End If
    Loop
    'load the data into the deep listbox
    list1(index + 1).Clear
    cc = 0
    Do
    cc = cc + 1
    If sublist2(sublistindex, cc) <> sublist2(0, 0) Then
            list1(index + 1).AddItem sublist2(sublistindex, cc)
        Else
            Exit Do
    End If
    Loop
    'set thiscallsallofthese() to true for the listbox
    '  where the sub was selected.
    thiscallsallofthese(index) = True
'  if the deep listbox has NOT thiscallsallofthese(), select no item in
'  the deep listbox, and clear all the listboxes deep to the deep listbox
'jjj this is where we might look deeper down the line for how to handle
'  the other deep ones.
If thiscallsallofthese(index + 1) = False Then
        If index + 2 <= maxlistboxindex Then
            For cc = index + 2 To maxlistboxindex
            list1(cc).Clear
            check1(cc).Value = 0
            Next cc
        End If
    Else
'  if the deep listbox had thiscallsallofthese(), then look for a match
'  between the saved variable and the new entries in the deep listbox.
'  If there is a match, select that item.
        If savedselecteditem <> "" Then
            For cc = 0 To list1(index + 1).ListCount - 1
            If list1(index + 1).List(cc) = savedselecteditem Then
                dontrecurse = True
                list1(index + 1).Selected(cc) = True
                dontrecurse = False
                GoTo itemselected
            End If
            Next cc
        End If
'  If there is not a match, select no item, and clear all the listboxes
'  deep to the deep listbox
        If index + 2 <= maxlistboxindex Then
            For cc = index + 2 To maxlistboxindex
            list1(cc).Clear
            Next cc
        End If
        GoTo dealwithsuperficialboxes
itemselected:
'now load the deep^2 box
If index + 2 <= maxlistboxindex Then
    '  enter into the deep listbox all of the subs that the selected
    '  sub calls.
    'first, find the sublist index for the selected sub or function
    sublistindex = 0
    Do
    sublistindex = sublistindex + 1
    If sublist2(sublistindex, 0) = savedselecteditem Then
            Exit Do
        ElseIf sublist2(sublistindex, 0) = sublist2(0, 0) Then
            MsgBox "Went through the whole sublist2() array, and couldn't find the selected sub or function.", 48, "Error"
            Exit Sub
    End If
    Loop
    'load the data into the deep listbox
    list1(index + 2).Clear
    cc = 0
    Do
    cc = cc + 1
    If sublist2(sublistindex, cc) <> sublist2(0, 0) Then
            list1(index + 2).AddItem sublist2(sublistindex, cc)
        Else
            Exit Do
    End If
    Loop
    'set thiscallsallofthese() to true for the listbox
    '  where the sub was selected.
    thiscallsallofthese(index + 1) = True
End If
End If   'If thiscallsallofthese(index + 1) = False
End If   'If check1(index + 1).value <> locked
'when an item in a listbox is selected, if the box deep to that is locked,
'  then
If check1(index + 1).Value = locked Then
'  if thiscallsallofthese for the selected listbox, give a message that
'  the box below has to be unlocked before a selection can be made in
'  the listbox that was selected.
    If thiscallsallofthese(index) = True Then
        MsgBox "You need to unlock the listbox deep to this before selecting an item in this listbox", 48, "Note"
        GoTo setcheckboxes
    End If
End If
dealwithsuperficialboxes:
'now deal with the superficial list boxes.
'if this is the most superficial list box, then just exit
If index = 0 Then GoTo setcheckboxes
'  if there is something highlighted in the superficial listbox, save
'  it in a variable.
If list1(index - 1).ListIndex <> -1 Then
        savedselecteditem = list1(index - 1).List(list1(index - 1).ListIndex)
    Else
        savedselecteditem = ""
End If
'  if the box above is unlocked, then load into it all the subs that call
'  the selected sub,
If check1(index - 1).Value <> locked Then
    list1(index - 1).Clear
    For thesub = 1 To totalnumberofsubs
    cc = 0
    Do
    cc = cc + 1
    If sublist2(thesub, cc) = currentselection Then
            list1(index - 1).AddItem sublist2(thesub, 0)
        ElseIf sublist2(thesub, cc) = sublist2(0, 0) Then
            Exit Do
    End If
    Loop
    Next thesub
'and set allofthesecallthis for the superficial listbox.
    thiscallsallofthese(index - 1) = False
'jjj don't process a click if the click is done on the currently-highlighted
'  item.
'  if superficial^2 is thiscallsallofthese, then clear it,
'  unlock it, and clear all list
'  boxes above it.
'If savedselecteditem<>"", then if savedselecteditem
'  exists in superficial^1, select it, make superficial ^ 2
'  allofthesecallthis, and load superficial^2 appropriately.  If it is not
'  there, do nothing.
'  if superficial^2 is allofthesecallthis, then look for savedselecteditem
'  in superficial.  If it is not there, clear and unlock superficial^2 and
'  everything superficial to it.  If it is there, select it, unlock
'  superficial^2, make it allofthesecallthis, and load superficial^2
'  appropriately.
'so, we are doing the same thing regardless of the thiscallsallofthese()
'  status of superficial^2
    If index >= 2 Then
            For cc = index - 2 To 0 Step -1
            list1(cc).Clear
            check1(cc).Value = 0
            Next cc

            'look for savedselecteditem in superficial
        If savedselecteditem <> "" Then
            For cc = 0 To list1(index - 1).ListCount - 1
            If list1(index - 1).List(cc) = savedselecteditem Then
                dontrecurse = True
                list1(index - 1).Selected(cc) = True
                dontrecurse = False
                GoTo itemselectedsup
            End If
            Next cc
        End If
'  If there is not a match, select no item, and clear all the listboxes
'  superficial to the superficial listbox
               Call form_paint
        GoTo setcheckboxes
itemselectedsup:

        'xxss
        'load superficial^2 with the appropriate stuff
        'jjj is it cleared at this point?
        thiscallsallofthese(index - 2) = False
        For thesub = 1 To totalnumberofsubs
        cc = 0
        Do
        cc = cc + 1
        If sublist2(thesub, cc) = savedselecteditem Then
                list1(index - 2).AddItem sublist2(thesub, 0)
            ElseIf sublist2(thesub, cc) = sublist2(0, 0) Then
                Exit Do
        End If
        Loop
        Next thesub

            Else
                Call form_paint
                GoTo setcheckboxes

End If  'if index>=2
End If    'If check1(index - 1).value <> locked
'when an item in a listbox is selected, if the box superficial to
'  that is locked, then
    If check1(index - 1).Value = locked Then
'  if thiscallsallofthese for the selected listbox, give a message that
'  the box below has to be unlocked before a selection can be made in
'  the listbox that was selected.
        If thiscallsallofthese(index - 1) = False Then
            MsgBox "You need to unlock the listbox superficial to this before selecting an item in this listbox", 48, "Note"
            GoTo setcheckboxes
        End If
    End If
'xxss
'  if the listbox above that listbox is not locked, then
'  if there is a selected item in the superficial listbox, save it in
'  a variable.
'  load into that
'  listbox all the subs that call the sub that was selected.  set
'  thiscallsallofthese() to false for the superficial listbox.
'  look for a match between the saved item and the new contents of the
'  superficial listbox.  If there is a match and superficial^2 has
'  allofthesecallthis(), then highlight the saved item.  Otherwise, clear
'  superficial^2 and all listboxes superficial to superficial^2.
'  if the deep box is locked and the superficial box is locked, too, give
'  a message that one of them has to be unlocked first.
If index > 0 And index < maxlistboxindex Then
    If check1(index + 1).Value = locked And check1(index - 1).Value = locked Then
        MsgBox "You must unlock one of the list boxes surrounding this one before selecting an item.", 48, "Surrounding list boxes both locked"
    End If
End If
Call form_paint
setcheckboxes:
For cc = 0 To maxlistboxindex
If list1(cc).ListCount = 0 Then
    check1(cc).Value = 0
End If
Next cc
'when an item is selected in a listbox, if the superficial listbox is
'  locked, then
'  if superficial is thiscallsallofthese, deal with the deep boxes.
'  if superficial is allofthesecallthis, then give a message that
'  selection of this item will redo the superficial box.  Ok to proceed?
'  if ok to proceed, then unlock the box and proceed as if the box were
'  unlocked.
End Sub
Sub list1_DragDrop (index As Integer, Source As Control, x As Single, Y As Single)
Call loadlistbox(index)
End Sub
Sub listmodulenames_MouseDown (button As Integer, Shift As Integer, x As Single, Y As Single)
If button = 1 Then Exit Sub
If button = 2 Then listmodulenames.Drag 1
'Call listmodulenames_click
End Sub
Sub loadlinesoftext ()
'load into linesoftext the lines that contain the variable declarations.
Dim nextline As String
Dim inasub As Integer
Dim inafunction As Integer
Dim endoffile As Integer
Dim linesread As Long
Dim sublistindex As Integer
Dim maxlength1 As Integer
Dim nextmodule As String
Dim modulenameindex As Integer
'modulenameindex starts at 1
modulenameindex = 0
Erase sublist2
'start subnumber at 1, so that sublist2(0, 0) can be null, to compare
'  against
subnumber = 0
Open filetoopen For Input As #2
Do  'start pulling in the module names
If EOF(2) Then
    Close
    Exit Sub
End If
'input the next module, called modulename
Line Input #2, nextmodule
nextmodule = Trim$(nextmodule)
'don't use the module entry if it isn't a .frm or a .bas
If Right$(nextmodule, 3) <> "frm" And Right$(nextmodule, 3) <> "bas" Then
    GoTo skipmakentry
End If
'modulename() has the .frm and .bas modules, in the order listed in .mak
modulenameindex = modulenameindex + 1
modulename(modulenameindex) = nextmodule
'prepare to input the module
Open nextmodule For Input As #1
label5.Caption = nextmodule
label5.Refresh
linesread = 0
more:
'starting a new module, we are neither in a sub nor in a function
inasub = False
inafunction = False
Do   'to input the sub names
If EOF(1) Then
    Close #1
    'gotthefile is the same as skipmakentry.  It says to get the
    '  next module to input
    GoTo gotthefile
End If
nextline = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
Line Input #1, nextline
If Len(nextline) > maxlength1 Then maxlength1 = Len(nextline)
linesread = linesread + 1
If linesread Mod 100 = 0 Then
    label1.Caption = Str$(linesread)
    label1.Refresh
End If
nextline = Trim$(nextline)
'find if we are starting a sub or function
If Left$(nextline, 4) = "sub " Then
        inasub = True
        nextline = Right$(nextline, Len(nextline) - 4)
        GoTo getname
    ElseIf Left(nextline, 9) = "function " Then
        inafunction = True
        nextline = Right$(nextline, Len(nextline) - 9)
        GoTo getname
End If
'loop and get the next line from the current module if nextline doesn't
'  have the name of a sub or a function
getname:
'get to here, nextline starts with "sub" or "function"
'put the name of the sub or function in sublist2(sub#, 0)
Dim thespace As Integer
thespace = InStr(nextline, " ")
If thespace = 0 Then
    MsgBox "sub or function found, but no name can be obtained", 48, "Error"
End If
subnumber = subnumber + 1
totalnumberofsubs = subnumber
sublist2(subnumber, 0) = Left$(nextline, thespace - 1) + "   " + nextmodule
'modulereference(subnumber, 0) = the index of the module name
modulereference(subnumber, 0) = modulenameindex
'now, we have the sub or function.
'  Input until get to the end of the sub or function
If EOF(1) Then
    MsgBox "Trying to find end of sub/function, but ran out of file", 48, "Error"
End If
nextline = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
Line Input #1, nextline
If Len(nextline) > maxlength1 Then maxlength1 = Len(nextline)
linesread = linesread + 1
If linesread Mod 100 = 0 Then
    label1.Caption = Str$(linesread)
    label1.Refresh
End If
'more means conintue inputting the current module, find the first line
'  of the next sub or function
If inasub Then
        If Left$(nextline, 7) = "End Sub" Then GoTo more
    ElseIf inafunction Then
        If Left$(nextline, 12) = "End Function" Then GoTo more
End If
gotthefile:
skipmakentry:
'Exit Sub
'goterror:
'MsgBox Error$(Err) + Str$(Erl)
'Exit Sub
End Sub
Sub loadlistbox (ByVal index As Integer)
Dim cc As Integer
Dim x As String
For cc = 0 To 4
list1(cc).Clear
Next cc
cc = 0
cc = cc + 1
If sublist2(cc, 0) = sublist2(0, 0) Then
    Call form_paint
    Exit Sub
End If
If modulename(modulereference(cc, 0)) = listmodulenames.List(listmodulenames.ListIndex) Then
    list1(index).AddItem sublist2(cc, 0)
End If
End Sub
Function min5 (ByVal x As Integer, ByVal Y As Integer, ByVal z As Integer, ByVal a As Integer, ByVal b As Integer)
'yields the minimum of the five integers, but if an integer=0, then
'  it is not reported.
If x = 0 And Y = 0 And z = 0 And a = 0 And b = 0 Then
    min5 = 0
    Exit Function
End If
If x = 0 Then x = 9999
If Y = 0 Then Y = 9999
If z = 0 Then z = 9999
If a = 0 Then a = 9999
If b = 0 Then b = 9999
If x < Y And x < z And x < a And x < b Then
    min5 = x
    Exit Function
End If
If Y < x And Y < z And Y < a And Y < b Then
    min5 = Y
    Exit Function
End If
If z < Y And z < x And z < a And z < b Then
    min5 = z
    Exit Function
End If
If a < x And a < Y And a < z And a < b Then
    min5 = a
    Exit Function
End If
If b < x And b < Y And b < z And b < a Then
    min5 = b
    Exit Function
End If
End Function
Sub moveboxesdownitem_Click ()
'shift the boxes down one
Dim cc As Integer
Dim boxindex As Integer
For boxindex = maxlistboxindex To 1 Step -1
list1(boxindex).Clear
dontrecurse2 = True
check1(boxindex).Value = check1(boxindex - 1).Value
dontrecurse2 = False
For cc = 0 To list1(boxindex - 1).ListCount - 1
list1(boxindex).AddItem list1(boxindex - 1).List(cc)
Next cc
If list1(boxindex - 1).ListIndex <> -1 Then
    dontrecurse = True
    list1(boxindex).Selected(list1(boxindex - 1).ListIndex) = True
    dontrecurse = False
End If
Next boxindex
list1(0).Clear
check1(0).Value = 0
Call form_paint
End Sub
Sub moveboxesupitem_Click ()
'shift the boxes up one
Dim cc As Integer
Dim boxindex As Integer
For boxindex = 0 To maxlistboxindex - 1
list1(boxindex).Clear
dontrecurse2 = True
check1(boxindex).Value = check1(boxindex + 1).Value
dontrecurse2 = False
For cc = 0 To list1(boxindex + 1).ListCount - 1
list1(boxindex).AddItem list1(boxindex + 1).List(cc)
Next cc
If list1(boxindex + 1).ListIndex <> -1 Then
    dontrecurse = True
    list1(boxindex).Selected(list1(boxindex + 1).ListIndex) = True
    dontrecurse = False
End If
Next boxindex
list1(maxlistboxindex).Clear
check1(maxlistboxindex).Value = 0
Call form_paint
End Sub
Sub openfileitem_Click ()
On Error GoTo goterror
Close
Dim cc
cmdialog1.InitDir = "c:\"
cmdialog1.Filter = "Project files (*.MAK)|*.mak"
cmdialog1.Action = 1
filetoopen = cmdialog1.Filename
On Error GoTo 0
Caption = "Sub Finder  --  ''" + filetoopen
listmodulenames.Clear
Erase modulereference
Erase sublist2
Erase modulename
For cc = 0 To maxlistboxindex
list1(cc).Clear
Next cc
loadlinesoftext
findallsubreferences
Exit Sub
goterror:
Exit Sub
End Sub
Function stripparentheses (theline As String)
Dim beginparenthesis As Integer
Dim endparenthesis As Integer
Dim beginp As String
Dim endp As String
Dim startlooking As Integer
beginp = "("
endp = ")"
beginparenthesis = InStr(theline, beginp)
If beginparenthesis = 0 Then
    stripparentheses = theline
    Exit Function
End If
endparenthesis = InStr(beginparenthesis + 1, theline, endp)
If endparenthesis = 0 Then
    stripparentheses = theline
    Exit Function
End If
theline = Left$(theline, beginparenthesis - 1) + " " + Right$(theline, Len(theline) - endparenthesis)
End Function
Function stripquotes (theline As String)
Dim beginquote As Integer
Dim endquote As Integer
beginquote = InStr(theline, doublequote)
If beginquote = 0 Then
    stripquotes = theline
    Exit Function
End If
endquote = InStr(beginquote + 1, theline, doublequote)
If endquote = 0 Then
    stripquotes = theline
    Exit Function
End If
theline = Left$(theline, beginquote - 1) + " " + Right$(theline, Len(theline) - endquote)
End Function